perm filename MFAIL.FAI[XX,LCS]4 blob sn#225205 filedate 1976-07-09 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE SMALL
C00010 ENDMK
CāŠ—;
	TITLE SMALL
	INTERNAL RJBX,CENTX,EXTEN,JDRAW,CENTER,LINX,UNPACK,ROFF
	INTERNAL NOZERO,EXCH,BMS,IABS,RHORZ,ABS,RTLINE,FLOAT,IFIX
	EXTERNAL .COMM.,STF,POSI,LL,LINES,BM,XRN,PTR,AMOD
	EXTERNAL PLTR
;;	DEFINE FLOAT(N)
;; <	TLC N,232000
;;	FADR N,N   >
	DEFINE FIXX(N)
<	KIFIX N,N  ↔ >



RJBX:	0		;R3=R3+R*RSTJ2
	MOVE 2,@(16)
	FMPR 	2,STF+=8
	FADRM	2,.COMM.+=4
	JRA	16,1(16)

CENTX:	0	;CENTX=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
	JSA 	16,AMOD
	JUMP	.COMM.+5
	JUMP	[=100.0]
	CAMGE   [-20.0];	;	;IF(R4.LT.-20)R4=R4+100
	FADR	[100.0];	;	; CATCHES R4=-95  ETC.
	CAML	[80.0];	;	;IF(R4.GE.80)R4=R4-100
	FSBR	[100.0];	;	; CATCHES NEG. MINIS ETC.
	MOVEM .COMM.+5		;[R4=AMOD(R4,100.0)]***********
	FMPR	[=7.0]
	FSBR	[=18.0]
	FMPR	STF+=8
	FADR	POSI+=9
	MOVEM	.COMM.+2
	JRA	16,(16)


EXTEN:	0	;FUNCTION EXTEN(X)
	HRRM	16,.+2
	JSA	16,AMOD	;EXTEN=AMOD(X,1.)*10.
	JUMP 	@0
	JUMP	[=1.0]
	FMPR	[=10.0]
	JRA	16,1(16)



JDRAW:	0	;SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
;;;	MOVE	2,@3(16)	;COMMON/LL/LL
	MOVE	13,@4(16)	;DIMENSION M(1)
	FMPR	13,@3(16)		;RC=RX*RSTJ2
	MOVE	14,@5(16)	;RD=RY*RSTJ2
	FMPR	14,@3(16)	;13 HAS RC,  14 HAS RD
	MOVE	3,@(16)		;DO 2 K=2,M(1)
	HRRZ	12,(16)  ; BRING IN ADR. OF M (ZERO LEFT HALF)
	MOVE	10,(12)		;PUT ADR. OF M IN 10
	ADDI	10,-1(12)
L2:	AOJ	12,	; SET UP LOOP
	CAILE	12,(10)	; SEE IF WE'VE PASSED END OF LOOP
	JRA	16,6(16)	; GO HOME
	HRRZM	12,.+4	; PUT ADR. OF VALUE M(K) IN LAST JUMP
; CALL UNPACK(A,B,M(K))
	JSA	16,UNPACK
	JUMP	6	;AA
	JUMP	7	;BB
	JUMP
;2  CALL LINES(FLOAT(A)*RC+R3,FLOAT(B)*RD+CENTR,LL)
;;	JSA	16,FLOAT
;;	JUMP	AA
;;	MOVE 0,AA
   	TLC 	6,232000
	FADR 	6,6   
	FMPR	6,13
	FADR	6,@1(16)
;;;	MOVEM	AA
;;	JSA	16,FLOAT
;;	JUMP	BB
;;;	MOVE 0,BB
   	TLC 	7,232000
	FADR 	7,7   
	FMPR	7,14
	FADR	7,@2(16)
;;;	MOVEM	BB
	JSA	16,LINES
	JUMP	6		;AA
	JUMP	7	;BB
	JUMP	LL
	JRST	L2

CENTER:	0    ;	SUBROUTINE CENTER(CNTR)
;  TO CENTER ITEMS CREATED WITH DRAWING PROG.
	;	COMMON /STF/RSTFAC(8),RSTJ2
	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	;	COMMON/POSI/STF(8),JJ2,POS
	;	EQUIVALENCE (R4,RJQ(2))
	JSA	16,AMOD    ;CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
	JUMP	.COMM.+5
	JUMP	[=100.0]
	FMPR	[=7.0]
	FADR	[=2.0]
	FMPR	STF+=8
	FADR	POSI+=9
	MOVEM	@(16)
	JRA	16,1(16)

LINX:	0	; SUBROUTINE LINX(A,B,C,D)
; C  SAVES SPACE FOR SINGLE LINES.
	MOVE	4,@(16)	;CALL LINES(A,B,3)
	MOVE	6,@1(16)
;CALL LINES(C,D,2)
	JSA	16,LINES
	JUMP 4
	JUMP 6
	JUMP	[=3]
	MOVE	6,@2(16) 
;; 6 AND 4 ARE FREE IN LINES  	MOVEM	CC
	MOVE	4,@3(16)
	JSA	16,LINES
	JUMP	6
	JUMP	4
	JUMP	[=2]
	JRA	16,4(16)

UNPACK:	0  ;	SUBROUTINE UNPACK(M,N,I)
	;	COMMON/LL/L
;C  L IS FOR VIS. OR INVIS. LINES.
	MOVEI	1,2	; L=2
 	MOVE	2,@2(16)	; N=I
	MOVE 4,2
	IDIV	2,[=100000000]  ;  M=N/100000000
	JUMPE	2,M2		; IF(M.EQ.0)GO TO 2
	AOJ 1,		; L=3
	MOVE 4,3		; N=N-100000000*M
M2:	MOVEM	1,LL
	IDIVI	4,23420    ;2	M=N/10000
			; 5 IS  N=MOD(N,10000)
	CAIG	4,1750	; IF(M.GT.1000)M=1000-M
	JRST	N2
	MOVNS 4
	ADDI 4,1750
N2:	CAIG 5,1750	; IF(N.GT.1000)N=1000-N
	JRST	P2
	MOVNS 5
	ADDI 5,1750
P2:	MOVEM	4,@(16)
	MOVEM	5,@1(16)
	JRA	16,3(16)

ROFF:	0	; FUNCTION ROFF(R)
	MOVSI	200400   ; S=.5
	SKIPGE	1,@(16)   ; IF(R)S=-S
	MOVNS
	FADR	1   ; ROFF=R+S
	JRA	16,1(16)

NOZERO:	0	;SUBROUTINE NOZERO(X)
	SKIPE	@(16)	; IF(X.EQ.0)X=1
	JRA	16,1(16)
	MOVSI 201400  	; MAKE ALL ZEROS INTO ONES.
	MOVEM	@(16)
	JRA	16,1(16)

EXCH:	0	; SUBROUTINE EXCH(X,Y)
	MOVE	@(16)
	EXCH	0,@1(16)
	MOVEM	0,@(16)
	JRA	16,2(16)

BMS:	0    	;	SUBROUTINE BMS
	MOVE	BM+1 ;COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RKY
	FMPR	STF+=8	; CALL LINES(RA,RJY+RC*RSTJ2,2)
	FADR	BM+2
	MOVEM	CENTX
	JSA	16,LINES	;	END
	JUMP	BM
	JUMP	CENTX
	JUMP	[2]
	JRA	16,(16)

ABS:	0
	JRST .+2

IABS:	0     		; FUNCTION IABS(N)
 	MOVM 0,@(16)  ;BECAUSE IABS IN LIB40 HAS A BUG.
	JRA	16,1(16)    	; IABS=N  ; IF(N)IABS=-N

RHORZ:	0  		; FUNCTION RHORZ(R)
	MOVE	@(16)  	; RHORZ=R*5.96-596.
	FMPR	[=5.96]
	FSBR	[=596.0]
	JRA	16,1(16)

RTLINE:	0	;FUNCTION RTLINE(L)
	MOVE 2,.COMM. ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
	CAMLE	2,[=4.0] ;RTLINE=-1
	JRST 	ZRO	;IF(R2.GT.4)GO TO 1
;;	HRRZ	@(16)	;IF(RN(L+2).NE.R2)RETURN
	MOVE 3,@(16)
;;	HRRZI	3,XRN  ; PUT ADR. OF XRN IN 3
;;	ADD	3,  ; 1  RTLINE=0
	SETO
	CAMN 2,XRN+1(3)
ZRO:	SETZ
	JRA	16,1(16)

FLOAT: 	0
	MOVE	0,@(16)
   	TLC 	0,232000
	FADR 	0,0   
	JRA	16,1(16)
IFIX:   0
	MOVE	0,@(16)
	JUMPGE	0,.+5
	MOVNS	0
	KAFIX 	0,233000    
	MOVNS	0
	CAIA
	KAFIX	0,233000
	JRA	16,1(16)

	END